perm filename PT2D.2[MSS,LCS] blob
sn#242183 filedate 1976-10-18 generic text, type T, neo UTF8
00100 SUBROUTINE PT2
00200 INTEGER VALID
00300 DIMENSION VALID(6),BARS(509)
00400 DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/,SLSP/11.0/,DIV/4./
00500 C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00600
00700 C ADD MORE TO VALID LATER *****
00750 COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00775 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
00800 COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
00900 1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512)
01000 1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
01100 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
01200 COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1) /SIZE/SIZE
01300 COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
01400 1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
01500 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
01600 1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,IV(80)),(NDPY,IV(81)),(TOT,KBAR(2))
01700 1,(BARS,KBAR(4))
01800 CC 1,(RSTF,RSTFAC(100))
01900 C TRNSP'S Bb, F, BBb, A, G, Eb.
02000 5 FORMAT(F,2I)
02100 CCC IF(RS.NE.'OLD')GO TO 2000
02200 CALL GETFIL('BARS')
02300 CALL FASTIN(KBAR,512)
02350 CALL FASTIN(RSTFAC,128)
02400 2000 TYPE 144
02500 144 FORMAT(' STAFF SIZE, TRANSP. '$)
02600 ACCEPT 5,SIZE,LL
02700 IF(SIZE.NE.0)GO TO 1
02800 SIZE=1
02900 GO TO 3
03000 1 DO 2 K=1,KT
03100 2 BARS(K)=BARS(K)*SIZE
03200 TOT=TOT*SIZE
03205 3 IF(RSTJ2.EQ.0)RSTJ2=1
03210 RA=JPG*SIZE*RSTJ2
03215 MPG=10./RA
03220 C MPG=NUM OF BRACES PER PAGE.
03225 SPG=10./MPG
03230 C SPG IS SPACE TO BE SET ABOVE STAFF 0
03235 RA=(RSTJ2*SIZE)/RPSZ(1)
03240 DO 141 K=1,JPG
03245 141 RPSZ(K)=RPSZ(K)*RA
03250 LPG=JPG
03300 IF(MOD(LL,7).EQ.0)GO TO 140
03400 DO 40 L=1,6
03500 40 IF(LL.EQ.VALID(L))GO TO 140
03600 TYPE 240
03700 GO TO 2000
03800 240 FORMAT(' THIS TRANSP NOT OFFERED')
03900
04000 140 TYPE 90,KT
04100 RA=0
04200 90 FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
04300
04400 NT=TOT/QLINE
04500 C USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
04600 T=NT
04700 16 AV=TOT/T
04800 X=AV
04900 JT=T
05000 C JT=TOTAL NUM OF LINES
05100 NN=KT/JT
05200 NX=KT-JT*NN
05300 DO 401 K=1,JT-NX
05400 401 NBAR(K)=NN
05500 IF(NX.EQ.0)GO TO 408
05600 M=NN+1
05700 DO 402 K=JT-NX+1,JT
05800 402 NBAR(K)=M
05900
06000 408 M=0
06100 KK=0
06200 B=0
06300 DO 403 K=1,JT
06400 T=B
06500 B=0
06600 Y=BARS(M)
06700 Z=BARS(M+1)
06800 C GET LAST OF PREV. LINE, FIRST OF THIS LINE
06900 DO 404 J=1,NBAR(K)
07000 M=M+1
07100 C M IS BAR COUNTER
07200 404 B=B+BARS(M)
07300 IF(T.EQ.0)GO TO 403
07400 X=ABS(B-T)
07500 IF(T.GT.B)GO TO 406
07600 CC IF(NBAR(K).EQ.1)GO TO 403
07700 IF(X.LE.Z)GO TO 403
07800 JJ=K
07900 JK=K-1
08000 W=-Z
08100 GO TO 407
08200 406 IF(X.LE.Y)GO TO 403
08300 CC IF(NBAR(K-1).EQ.1)GO TO 403
08400 JK=K
08500 JJ=K-1
08600 407 IF(NBAR(JJ).EQ.1)GO TO 403
08700 KK=-1
08800 NBAR(JJ)=NBAR(JJ)-1
08900 NBAR(JK)=NBAR(JK)+1
09000 B=B+W
09100 403 CONTINUE
09200 IF(KK)GO TO 408
09300 C GO BACK IF MORE TO SHUFFLE
09400 J=1
09500 TYPE 306,AV
09600 DO 305 K=1,JT
09700 L=NBAR(K)-1+J
09800 T=0
09900 DO 8 M=J,L
10000 8 T=T+BARS(M)
10100 306 FORMAT(1XF4.0,3X8F4.0)
10200 TYPE 306,T,(BARS(N),N=J,L)
10300 305 J=L+1
10400
10401 RPG=JT
10450 RPG=RPG/MPG
10500 105 TYPE 104,RPG,JT
10600 104 FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
10700 C FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
10800 KA=0
10900 ACCEPT 5,T,N,KL
11000 C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
11100 IF(KL.NE.0)GO TO 110
11200 C NO MORE THAN 36 NUMS, INCLUDING 0S (FOR PAGE MARKS)
11300 IF(T.EQ.0)GO TO 11
11400 JT=T
11500 IF(N.EQ.0)GO TO 16
11600 C N=0 MEANS T= NUM OF LINES DESIRED.
11700
11800 111 FORMAT(36I)
11900 110 REREAD 111,NBAR
12000 911 DO 112 K=36,1,-1
12100 KP=NBAR(K)
12200 KA=KA+KP
12300 112 IF(KP.EQ.0.AND.KA.EQ.0)KL=K
12400 IF(KA.NE.KT)GO TO 105
12500 C MISMATCH!
12600 N=26-2*MOD(KL-1,12)
12700 IF(N.EQ.26)N=0
12800 C TO SPACE OUT STAVES VERTICALLY
12900 CC IF(IPG)GO TO 11
13000 CC IF(NBAR(1).NE.0)GO TO 11
13100 CC DO 711 K=1,36
13200 CC IF(K.GT.J)IV(K)=0
13300 CC711 NBAR(K)=IV(K)
13400 CC GO TO 911
13500 11 CALL WRTPAG
13600 END